home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / slib / Bev2slib.scm < prev    next >
Encoding:
Text File  |  2004-01-06  |  2.9 KB  |  95 lines
  1. ;;;; "Bev2slib.scm" Build SLIB catalogs for Stephen Bevan's libraries.
  2. ;Copyright (C) 1998 Aubrey Jaffer
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20. ;;; Put this file into the implementation-vicinity directory for your
  21. ;;; scheme implementation.
  22.  
  23. ;;; Add the line
  24. ;;;    (load (in-vicinity (implementation-vicinity) "Bev2slib.scm"))
  25. ;;; to "mkimpcat.scm"
  26.  
  27. ;;; Delete "slibcat" in your implementation-vicinity.
  28.  
  29. ;;; Bind `Bevan-dir' to the directory containing directories "bawk",
  30. ;;; "mawk", "pathname", etc.  Bev2slib.scm will put entries into the
  31. ;;; catalog only for those directories and files which exist.
  32.  
  33. (let ((Bevan-dir (in-vicinity (library-vicinity) "../"));"/usr/local/lib/Bevan/"
  34.       (catname "sitecat"))
  35.   (call-with-output-file (in-vicinity (implementation-vicinity) catname)
  36.     (lambda (op)
  37.       (define (display* . args)
  38.     (for-each (lambda (arg) (display arg op)) args)
  39.     (newline op))
  40.       (define (add-alias from to)
  41.     (display " " op)
  42.     (write (cons from to) op)
  43.     (newline op))
  44.  
  45.       (begin
  46.     (display* ";\"" catname "\" Site-specific SLIB catalog for "
  47.           (scheme-implementation-type) (scheme-implementation-version)
  48.           ".  -*-scheme-*-")
  49.     (display* ";")
  50.     (display* ";            DO NOT EDIT THIS FILE")
  51.     (display* "; it is automagically generated by \"Bev2slib.scm\"")
  52.     (newline op)
  53.     )
  54.  
  55.       ;; Output association lists to file "sitecat"
  56.  
  57.       (for-each
  58.        (lambda (dir)
  59.      (let* ((vic (in-vicinity Bevan-dir (string-append dir "/")))
  60.         (map-file (in-vicinity vic (string-append dir ".map"))))
  61.  
  62.        (display* ";;; from " map-file)
  63.        (display* "(")
  64.  
  65.        (and
  66.         (file-exists? map-file)
  67.         (call-with-input-file map-file
  68.           (lambda (ip)
  69.         (define files '())
  70.         (do ((feature (read ip) (read ip)))
  71.             ((eof-object? feature))
  72.           (let* ((type (read ip))
  73.              (file (read ip))
  74.              (fsym (string->symbol (string-append "Req::" file))))
  75.             (and (not (assq fsym files))
  76.              (set! files (cons (cons fsym file) files)))
  77.             (add-alias feature fsym)))
  78.         (for-each
  79.          (lambda (pr) (add-alias (car pr) (in-vicinity vic (cdr pr))))
  80.          files)
  81.         )))
  82.  
  83.        (display* ")")))
  84.  
  85.        '("char-set" "conc-string" "string" "string-03"
  86.             "avl-tree" "avl-trie"
  87.             "bawk" "mawk" "pathname"))
  88.  
  89.       (begin
  90.     (display* "(")
  91.     (add-alias 'btree (in-vicinity Bevan-dir "bawk/btree"))
  92.     (add-alias 'read-line 'line-i/o)
  93.     (display* ")")
  94.     ))))
  95.